home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / gawk / gawk213b.zoo / test / lisp / good < prev    next >
Text File  |  1991-06-03  |  5KB  |  73 lines
  1. walk (LISP in awk)    Copyright (c) 1988, 1990 Roger Rohrbach
  2.  
  3. -> (lambda (exp) (cond ((isconst exp) (list (mksend 1 exp))) (t (compapply (func exp) (complis (arglist exp)) (length (arglist exp))))))
  4. (lambda (u) (cond ((null u) (quote ())) ((null (rest u)) (compexp (first u))) (t (append-3 (compexp (first u)) (list (mkalloc 1)) (complis (rest u))))))
  5. (lambda (fn vals n) (append-3 vals (mklink n) (list (mkcall fn))))
  6. (lambda (x) (or (numberp x) (eq x t) (eq x ()) (and (not (atom x)) (eq (first x) (quote quote)))))
  7. (lambda (x) (first x))
  8. (lambda (x) (rest x))
  9. (lambda (dest val) (list (quote MOVEI) dest val))
  10. (lambda (dest) (list (quote PUSH) (quote sp) dest))
  11. (lambda (fn) (list (quote CALL) fn))
  12. (lambda (n) (cond ((eqn n 1) (quote ())) (t (concat (mkmove n 1) (mklink1 (sub1 n))))))
  13. (lambda (n) (cond ((zerop n) (quote ())) (t (concat (mkpop n) (mklink1 (sub1 n))))))
  14. (lambda (n) (list (quote POP) (quote sp) n))
  15. (lambda (dest val) (list (quote MOVE) dest val))
  16. (lambda (x) (car x))
  17. (lambda (x) (cdr x))
  18. (lambda (element sequence) (cond ((listp sequence) (cons element sequence)) (t (quote ()))))
  19. (lambda (l1 l2 l3) (append l1 (append l2 l3)))
  20. (lambda (x) (cond ((consp x) t) ((null x) t) (t ())))
  21. (lambda (e) (not (atom e)))
  22. (lambda (x y) (eq x y))
  23. addition undefined for given arguments
  24. subtraction undefined for given arguments
  25. (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
  26. (lambda (n) (or (succ n _integers_) (error NOADD)))
  27. (lambda (n) (or (pred n _integers_) (error NOSUB)))
  28. (lambda (x) (eq x 0))
  29. (lambda (x) (member x _integers_))
  30. (lambda (x y) (member x (after _integers_ y)))
  31. (lambda (x y) (member y (after _integers_ x)))
  32. (lambda (x y) (cond ((zerop y) x) (t (difference (sub1 x) (sub1 y)))))
  33. (lambda (s) (cond ((atom s) 0) ((null (cdr s)) 1) (t (add1 (length (cdr s))))))
  34. (lambda (x y) (length (append (before _integers_ x) (before _integers_ y))))
  35. (lambda (x y) (cond ((null x) y) ((member (car x) y) (union (cdr x) y)) (t (cons (car x) (union (cdr x) y)))))
  36. (lambda (x y) (cond ((null x) ()) ((member (car x) y) (cons (car x) (intersection (cdr x) y))) (t (intersection (cdr x) y))))
  37. (lambda (in out) (cond ((null in) ()) ((member (car in) out) (ldifference (cdr in) out)) (t (cons (car in) (ldifference (cdr in) out)))))
  38. (lambda (a b) (cond ((null a) t) ((member (car a) b) (subsetp (cdr a) b)) (t ())))
  39. (lambda (a b) (and (subsetp a b) (subsetp b a)))
  40. (lambda (e) (car (cdr e)))
  41. (lambda (e) (cdr (cdr e)))
  42. (lambda (e) (car (car e)))
  43. (lambda (e) (cdr (car e)))
  44. (lambda (e) (car (cdr (car e))))
  45. (lambda (e) (car (cdr (cdr e))))
  46. (lambda (e) (cdr (cdr (car e))))
  47. (lambda (e) (cdr (car (cdr e))))
  48. (lambda (e) (eq e ()))
  49. (lambda (e) (eq e ()))
  50. (lambda (s) (cond ((atom s) s) (t (ff (car s)))))
  51. (lambda (x y z) (cond ((atom z) (cond ((eq z y) x) (t z))) (t (cons (subst x y (car z)) (subst x y (cdr z))))))
  52. (lambda (x y) (or (and (atom x) (atom y) (eq x y)) (and (not (atom x)) (not (atom y)) (equal (car x) (car y)) (equal (cdr x) (cdr y)))))
  53. (lambda (x y) (cond ((null x) y) (t (cons (car x) (append (cdr x) y)))))
  54. (lambda (x y) (and (not (null y)) (or (equal x (car y)) (member x (cdr y)))))
  55. (lambda (x y) (cond ((and (null x) (null y)) ()) ((and (not (atom x)) (not (atom y))) (cons (list (car x) (car y)) (pair (cdr x) (cdr y))))))
  56. (lambda (x y) (cond ((null y) ()) ((eq caar y x) (car y)) (t (assoc x (cdr y)))))
  57. (lambda (x y) (cond ((atom y) (_sublis x y)) (t (cons (sublis x (car y)) (sublis x (cdr y))))))
  58. (lambda (x z) (cond ((null x) z) ((eq (caar x) z) (cadar x)) (t (_sublis (cdr x) z))))
  59. (lambda (e) (cond ((atom e) ()) ((null (cdr e)) (car e)) (t (last (cdr e)))))
  60. (lambda (x) (_reverse x ()))
  61. (lambda (x y) (cond ((null x) y) (t (_reverse (cdr x) (cons (car x) y)))))
  62. (lambda (e l) (cond ((null l) ()) ((equal e (car l)) (remove e (cdr l))) (t (cons (car l) (remove e (cdr l))))))
  63. (lambda (x y) (cond ((or (null y) (null (cdr y))) ()) ((eq (car y) x) (cadr y)) (t (succ x (cdr y)))))
  64. (lambda (x y) (cond ((or (null y) (null (cdr y))) ()) ((eq (cadr y) x) (car y)) (t (pred x (cdr y)))))
  65. (lambda (x y) (cond ((atom x) ()) ((null (cdr x)) ()) ((equal (car x) y) ()) ((equal (cadr x) y) (cons (car x) ())) (t (cons (car x) (before (cdr x) y)))))
  66. (lambda (x y) (cond ((atom x) ()) ((equal (car x) y) (cdr x)) (t (after (cdr x) y))))
  67. (lambda (x) (succ x Properties))
  68. (lambda (x i) ((lambda (pr) (cond ((null pr) ()) (t (cadr pr)))) (assoc i (plist x))))
  69. (lambda (x v i) (and (or (plist x) (set (quote Properties) (cons x (cons () Properties)))) (and (set (quote Properties) (append (before Properties x) (append (list x (cons (list i v) ((lambda (l) (remove (assoc i l) l)) (plist x)))) (cdr (after Properties x))))) v)))
  70. (lambda (x i) (and (get x i) (set (quote Properties) (append (before Properties x) (append (list x ((lambda (l) (remove (assoc i l) l)) (plist x))) (cdr (after Properties x))))) i))
  71. (lambda (f l) (cond ((null l) ()) (t (cons (eval (list f (list (quote quote) (car l)))) (mapcar f (cdr l))))))
  72. (lambda (f args) (cond ((null args) ()) (t (eval (cons f (mapcar (quote (lambda (a) (list (quote quote) a))) args))))))
  73.